home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / !runtime / meta.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-18  |  2.0 KB  |  91 lines  |  [TEXT/R*ch]
  1. /* Primitives for the toplevel */
  2.  
  3. #include "alloc.h"
  4. #include "globals.h"
  5. #include "major_gc.h"
  6. #include "memory.h"
  7. #include "minor_gc.h"
  8. #include "mlvalues.h"
  9. #include "prims.h"
  10.  
  11. extern value interprete();
  12.  
  13. value start_interp(prog, offset, len) /* ML */
  14.      value prog, offset, len;
  15. {
  16. #if defined(MOSML_BIG_ENDIAN) && !defined(ALIGNMENT)
  17.   fixup_endianness(&Byte(prog, 0), (asize_t) Long_val(len));
  18. #endif
  19.   return interprete(&Byte(prog, Long_val(offset)));
  20. }
  21.  
  22. value realloc_global(size)      /* ML */
  23.      value size;
  24. {
  25.   mlsize_t requested_size, actual_size, i;
  26.   value new_global_data;
  27.  
  28.   requested_size = Long_val(size);
  29.   actual_size = Wosize_val(global_data);
  30.   if (requested_size >= actual_size) {
  31.     requested_size = (requested_size + 0x100) & 0xFFFFFF00;
  32.     new_global_data = alloc_shr(requested_size, 0);
  33.     for (i = 0; i < actual_size; i++)
  34.       initialize(&Field(new_global_data, i), Field(global_data, i));
  35.     for (i = actual_size; i < requested_size; i++){
  36.       Field (new_global_data, i) = Val_long (0);
  37.     }
  38.     modify(&Field(new_global_data, GLOBAL_DATA), new_global_data);
  39.     global_data = new_global_data;
  40.   }
  41.   return Atom(0);
  42. }
  43.     
  44.     
  45. value static_alloc(size)        /* ML */
  46.      value size;
  47. {
  48.   return (value) stat_alloc((asize_t) Long_val(size));
  49. }
  50.  
  51. value static_free(blk)          /* ML */
  52.      value blk;
  53. {
  54.   stat_free((char *) blk);
  55.   return Atom(0);
  56. }
  57.  
  58. value static_resize(blk, new_size) /* ML */
  59.      value blk, new_size;
  60. {
  61.   return (value) stat_resize((char *) blk, (asize_t) Long_val(new_size));
  62. }
  63.  
  64. value obj_is_block(arg)             /* ML */
  65.      value arg;
  66. {
  67.   return Atom(Is_block(arg));
  68. }
  69.  
  70. value obj_block(tag, size) /* ML */
  71.      value tag, size;
  72. {
  73.   value res;
  74.   mlsize_t sz, i;
  75.   tag_t tg;
  76.  
  77.   sz = Long_val(size);
  78.   tg = Long_val(tag);
  79.   if (sz == 0) return Atom(tg);
  80.   res = alloc(sz, tg);
  81.   for (i = 0; i < sz; i++)
  82.     Field(res, i) = Val_long(0);
  83.  
  84.   return res;
  85. }
  86.  
  87. value available_primitives()    /* ML */
  88. {
  89.   return copy_string_array(names_of_cprim);
  90. }
  91.